home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / teglp.zip / SAMPROGS.ZIP / SAMC0104.PAS < prev    next >
Pascal/Delphi Source File  |  1990-06-27  |  2KB  |  112 lines

  1. {$F+}  { -- far code model is required for any functions that }
  2.        { -- are to be used as Event Handlers }
  3.  
  4. Uses
  5.     dos,
  6.     graph,
  7.  
  8.     virtmem,
  9.     teglfont,
  10.     fastgrph,
  11.     TEGLIntr,
  12.     TEGLICON,
  13.     TEGLGRPH,
  14.     TEGLUnit,
  15.     TEGLMenu,
  16.     SenseMs,
  17.     DebugUnt,
  18.     TEGLEasy;
  19.  
  20.  
  21. { -- insert variables here }
  22.  
  23. VAR
  24.   om1, om2 : OptionMPtr;
  25.  
  26. { -- insert procedures and functions here }
  27.  
  28.  
  29. FUNCTION GetMsSense(FS:imagestkptr; Ms: msclickptr) : WORD;
  30.   BEGIN
  31.     SetMouseSense(fs^.x,fs^.y);
  32.     GetMsSense := 1;
  33.   END;
  34.  
  35.  
  36. FUNCTION InfoOption(FS:imagestkptr; Ms: msclickptr) : WORD;
  37.    VAR
  38.       x,y,x1,y1      : word;
  39.       ifs             : ImageStkPtr;
  40.       ax,ay,ax1,ay1  : word;
  41.       option         : word;
  42.    BEGIN
  43.       HideMouse;
  44.  
  45.       x  := 200;
  46.       y  := 120;
  47.       x1 := x+340;
  48.       y1 := y+100;
  49.  
  50.       ax := Ms^.ms.x+FS^.x;
  51.       ay := Ms^.ms.y+FS^.y;
  52.       ax1 := Ms^.ms.x1+FS^.x;
  53.       ay1 := Ms^.ms.y1+FS^.y;
  54.  
  55.  
  56.       PushImage(x,y,x1,y1);
  57.       IFS := stackptr;
  58.  
  59.       ZipToBox(ax,ay,ax1,ay1,x,y,x1,y1);
  60.  
  61.       SetColor(White);
  62.       ShadowBox(x,y,x1,y1);
  63.  
  64.       SetColor(Black);
  65.       OutTEGLtextxy(x+5,y+5,'TEGL Windows Toolkit II');
  66.       OutTEGLtextxy(x+5,y+5+TEGLCharHeight,
  67.         'Jan. 1, 1990, Program Written by Richard Tom');
  68.  
  69.       PutPict(x+280,y+75,@ImageOk,Black);
  70.       DefineMouseClickArea(IFS,280,75,280+35,75+12,TRUE,
  71.         NilUnitProc,MSClick);
  72.       SetMousePosition(x+290,y+85);
  73.       ShowMouse;
  74.  
  75.       WHILE CheckforMouseSelect(IFS)=NIL DO;
  76.  
  77.       HideMouse;
  78.       DropStackImage(ifs);
  79.       ZipFromBox(ax,ay,ax1,ay1,ifs^.x,ifs^.y,ifs^.x1,ifs^.y1);
  80.       ShowMouse;
  81.  
  82.       InfoOption := 1;
  83.    END;
  84.  
  85.  
  86.  
  87. BEGIN
  88.  
  89.    EasyTEGL;
  90.  
  91.    { -- insert the example code here }
  92.    { -- press Ctrl-Break to exit program }
  93.  
  94.    om1 := CreateOptionMenu(@Font14);
  95.    DefineOptions(om1,' Open ', true, NilUnitProc);
  96.    DefineOptions(om1,'Info...',true, InfoOption);
  97.    DefineOptions(om1,'--',     false,NilUnitProc);
  98.    DefineOptions(om1,' Quit ', true, Quit);
  99.  
  100.    om2 := CreateOptionMenu(@Font14);
  101.    DefineOptions(om2,' Memory ',true,ShowCoordinates);
  102.    DefineOptions(om2,' Mouse Sensitivity ',true,GetMsSense);
  103.  
  104.    CreateBarMenu(0,0,getmaxx);
  105.    OutBarOption(' File ',om1);
  106.    OutBarOption(' Utility ',om2);
  107.  
  108.    { -- control is then passed to the supervisor }
  109.  
  110.    TEGLSupervisor;
  111. END.
  112.